Data Source:
NYC published COVID-19 Data LINK
NYC published MTA Data LINK

Around 5 Million riders/day. Observed initial drop of rider around March 8th.
plot_ly(
data = station_data_3,
x = ~ date,
y = ~ total_in_day,
name = 'Day Riders',
type = 'bar'
) %>%
add_trace(
x = ~ date,
y = ~ total_in_day,
type = 'scatter',
mode = 'markers+lines',
name = 'Weekly Avg',
line = list(
color = 'rgb(205, 12, 24)',
width = 4,
shape = "spline"
),
opacity = 0.75,
transforms = list(
list(
type = 'aggregate',
groups = station_data_3$week_seq,
aggregations = list(list(
target = 'y',
func = 'avg',
enabled = T
))
)
)
) %>% layout(
title = "NYC MTA Ridership",
xaxis = list(title = ""),
yaxis = list(title = "# of People")
)
plot_ly(data = station_data_3) %>%
add_trace(
x = ~ date,
y = ~ total_in_day,
type = 'scatter',
mode = 'markers+lines',
name = 'Weekly MTA Riderships',
line = list(
color = 'rgb(205, 12, 24)',
width = 4,
shape = "spline"
),
opacity = 0.75,
transforms = list(
list(
type = 'aggregate',
groups = station_data_3$week_seq,
aggregations = list(list(
target = 'y',
func = 'avg',
enabled = T
))
)
)
) %>%
add_trace(
data = ny_covid,
x = ~ date,
y = ~ cases,
yaxis = "y2",
type = 'scatter',
mode = 'markers+lines',
name = 'NYC COVID-19 <br>New Confirmed Cases',
line = list(# color = 'rgb(205, 12, 24)',
width = 4,
shape = "spline"),
marker = list(color = 'RGB(64, 154, 203)')
) %>%
add_segments(
x = '2020-03-22',
xend = '2020-03-22',
y = 400000,
yend = 5000000,
name = "NYC Stay At Home Order",
line = list(
dash = 'dot',
width = 3,
color = "#2ca02c"
)
) %>%
layout(
title = "MTA vs COVID-19",
legend = list(x = 0.05, y = 0.5),
xaxis = list(title = ""),
yaxis = list(title = "AVG Weekly MTA Riderships"),
yaxis2 = list(
tickfont = list(color = "#d62728"),
overlaying = "y",
side = "right",
title = "Daily New COVID-19 Cases"
),
margin = list(r = 120)
)
plot_ly(data = station_data_3) %>%
add_trace(
x = ~ date,
y = ~ total_in_day,
type = 'scatter',
mode = 'markers+lines',
name = 'Weekly MTA Riderships',
line = list(
color = 'rgb(205, 12, 24)',
width = 4,
shape = "spline"
),
opacity = 0.75,
transforms = list(
list(
type = 'aggregate',
groups = station_data_3$week_seq,
aggregations = list(list(
target = 'y',
func = 'avg',
enabled = T
))
)
)
) %>%
add_trace(
data = ny_covid,
x = ~ date,
y = ~ cumulative_case,
yaxis = "y2",
type = 'scatter',
mode = 'markers+lines',
name = 'NYC COVID-19 <br>Cumulative Cases',
line = list(# color = 'rgb(205, 12, 24)',
width = 4,
shape = "spline"),
marker = list(color = 'RGB(64, 154, 203)')
) %>%
add_segments(
x = '2020-03-22',
xend = '2020-03-22',
y = 400000,
yend = 4500000,
name = "NYC Stay At Home Order",
line = list(
dash = 'dot',
width = 3,
color = "#2ca02c"
)
) %>%
layout(
title = "MTA vs COVID-19",
legend = list(x = 0.05, y = 0.5),
xaxis = list(title = ""),
yaxis = list(title = "AVG Weekly MTA Riderships"),
yaxis2 = list(
tickfont = list(color = "#d62728"),
overlaying = "y",
side = "right",
title = "Cumulative COVID-19 Cases"
),
margin = list(r = 120)
)
plot_ly(data = station_data_3) %>%
add_trace(
x = ~ date,
y = ~ total_in_day,
type = 'scatter',
mode = 'markers+lines',
name = 'Weekly MTA Riderships',
line = list(
color = 'rgb(205, 12, 24)',
width = 4,
shape = "spline"
),
opacity = 0.75,
transforms = list(
list(
type = 'aggregate',
groups = station_data_3$week_seq,
aggregations = list(list(
target = 'y',
func = 'avg',
enabled = T
))
)
)
) %>%
add_trace(
data = ny_covid,
x = ~ date,
y = ~ cumulative_case,
yaxis = "y2",
type = 'scatter',
mode = 'markers+lines',
name = 'NYC COVID-19 <br>Cumulative Cases',
line = list(# color = 'rgb(205, 12, 24)',
width = 4,
shape = "spline"),
marker = list(color = 'RGB(64, 154, 203)')
) %>%
add_trace(
data = ny_covid,
x = ~ date -14,
y = ~ cumulative_case,
yaxis = "y2",
type = 'scatter',
mode = 'markers+lines',
name = 'Shift 14 Days Back',
line = list(# color = 'rgb(205, 12, 24)',
width = 4,
shape = "spline"),
marker = list(color = 'RGB(64, 154, 203)')
) %>%
add_segments(
x = '2020-03-20',
xend = '2020-04-2',
y = 2600000,
yend = 2600000,
name = "Shift 14 Days Back",
line = list(
dash = 'dashdot',
width = 3,
color = "MediumPurple"
)
) %>%
layout(
title = "MTA vs COVID-19",
legend = list(x = 0.05, y = 0.5),
xaxis = list(title = ""),
yaxis = list(title = "AVG Weekly MTA Riderships"),
yaxis2 = list(
tickfont = list(color = "#d62728"),
overlaying = "y",
side = "right",
title = "14 Days"
),
margin = list(r = 120)
)
How people move in NYC by subway, Red means people leave station blue means people go in.
Noax <- list(
title = "",
zeroline = FALSE,
showline = FALSE,
showticklabels = FALSE,
showgrid = FALSE
)
station_data_march = station_data_2[datetime > "2020-03-01 00:00:00", ]
station_data_march[, timeCut := cut(datetime, breaks = "240 mins")]
pal <- c("grey", "blue", "red")
plot_ly(
# data = head(station_data_2, 100000),
data = station_data_march,
type = "scatter",
mode = "markers",
x = ~ station_longitude ,
y = ~ station_latitude,
marker = list(size = ~ log((total_flow) + 0.1)),
color = ~ in_out,
colors = ~ pal,
ids = ~ station_seq ,
frame = ~ timeCut
) %>%
layout(xaxis = Noax, yaxis = Noax) %>%
animation_slider(currentvalue = list(
prefix = "Time ",
font = list(color = "red"),
xanchor = "center"
))